;;;;;;;;;;;;;;;;;;;;
; x64 Emit Functions
;;;;;;;;;;;;;;;;;;;;

;module
(env-push)

(defcvar 'stack_align 8 'stack_state '(:r0 :r1 :r2 :r3 :r4 :r5 :r6 :r7 :r8 :r9 :r10 :r11 :r12 :r13 :r14))

(defun emit-native-reg? (r) (find r '(:r0 :r1 :r2 :r3 :rsp :r4 :r5 :r6 :r7 :r8 :r9 :r10 :r11 :r12 :r13 :r14)))

(defun x64-rr (o s d)
	(emitm-byte (+ 0x48 (<< (>> s 3) 2) (>> d 3)) o (+ 0xc0 (<< (logand 7 s) 3) (logand 7 d))))

(defun x64-dr (o s1 s2 d)
	(defq s1l (logand 7 s1) s1h (>> s1 3)
		s2l (logand 7 s2) s2h (>> s2 3)
		dl (logand 7 d) dh (>> d 3))
	(emitm-byte (+ 0x48 (<< dh 2) (<< s2h 1) s1h) o)
	(cond
		((and (/= s1 5) (/= s1 13))
			(emitm-byte (+ 0x04 (<< dl 3)) (+ (<< s2l 3) s1l)))
		(:t (emitm-byte (+ 0x44 (<< dl 3)) (+ (<< s2l 3) s1l) 0))))

(defun x64-dr-bs (o s1 s2 d)
	(defq s1l (logand 7 s1) s1h (>> s1 3)
		s2l (logand 7 s2) s2h (>> s2 3)
		dl (logand 7 d) dh (>> d 3))
	(emitm-byte (+ 0x48 (<< dh 2) (<< s2h 1) s1h) 0xf o)
	(cond
		((and (/= s1 5) (/= s1 13))
			(emitm-byte (+ 0x04 (<< dl 3)) (+ (<< s2l 3) s1l)))
		(:t (emitm-byte (+ 0x44 (<< dl 3)) (+ (<< s2l 3) s1l) 0))))

(defun x64-ir (o s c d)
	(emitm-byte (+ 0x48 (<< (>> d 3) 2) (>> s 3)) o)
	(cond
		((and (= c 0) (/= s 5) (/= s 13))
			(emitm-byte (+ (<< (logand 7 d) 3) (logand 7 s)))
			(if (or (= s 4) (= s 12)) (emitm-byte 0x24)))
		((<= -0x80 c 0x7f)
			(emitm-byte (+ 0x40 (<< (logand 7 d) 3) (logand 7 s)))
			(if (or (= s 4) (= s 12)) (emitm-byte 0x24))
			(emitm-byte c))
		((<= -0x80000000 c 0x7fffffff)
			(emitm-byte (+ 0x80 (<< (logand 7 d) 3) (logand 7 s)))
			(if (or (= s 4) (= s 12)) (emitm-byte 0x24))
			(emitm-int c))
		(:t (throw "x64-ir constant out of range !" c))))

(defun x64-ir-bs (o s c d)
	(defq sl (logand 7 s) sh (>> s 3)
		dl (logand 7 d) dh (>> d 3))
	(emitm-byte (+ 0x48 (<< dh 2) sh) 0x0f o)
	(cond
		((and (= c 0) (/= s 5) (/= s 13))
			(emitm-byte (+ (<< dl 3) sl))
			(if (or (= s 4) (= s 12)) (emitm-byte 0x24)))
		((<= -0x80 c 0x7f)
			(emitm-byte (+ 0x40 (<< dl 3) sl))
			(if (or (= s 4) (= s 12)) (emitm-byte 0x24))
			(emitm-byte c))
		((<= -0x80000000 c 0x7fffffff)
			(emitm-byte (+ 0x80 (<< dl 3) sl))
			(if (or (= s 4) (= s 12)) (emitm-byte 0x24))
			(emitm-int c))
		(:t (throw "x64-ir-bs constant out of range !" c))))

(defun x64-pr (o l d)
	(defq dl (logand 7 d) dh (>> d 3) l (- l *pc* 7))
	(cond
		((<= -0x80000000 l 0x7fffffff)
			(emitm-byte (+ 0x48 (<< dh 2)) o (+ 0x5 (<< dl 3)))
			(emitm-int l))
		(:t (throw "x64-pr constant out of range !" l))))

(defun emit-push (&rest b)
	(each (lambda (r)
		(if (>= r 8)
			(emitm-byte 0x41 (+ 0x48 r))
			(emitm-byte (+ 0x50 r)))) b))

(defun emit-pop (&rest b)
	(reach (lambda (r)
		(if (>= r 8)
			(emitm-byte 0x41 (+ 0x50 r))
			(emitm-byte (+ 0x58 r)))) b))

(defun emit-swp-rr (s d)
	(unless (eql s d)
		(if (eql s 0) (setq s d d 0))
		(defq sl (logand 7 s) sh (>> s 3) dl (logand 7 d) dh (>> d 3))
		(if (= d 0)
			(emitm-byte (+ 0x48 sh) (+ 0x90 sl))
			(emitm-byte (+ 0x48 (<< sh 2) dh) 0x87 (+ 0xc0 (<< sl 3) dl)))))

(defun x64-call-jump-p (o l)
	(emitm-byte 0xff o)
	(emitm-int (- l *pc* 4)))

(defun x64-call-jump-r (o d)
	(defq dl (logand 7 d))
	(if (>= d 8) (emitm-byte 0x41))
	(emitm-byte 0xff (+ o dl)))

(defun x64-call-jump-i (o d c)
	(defq dl (logand 7 d))
	(if (>= d 8) (emitm-byte 0x41))
	(emitm-byte 0xff)
	(cond
		((and (= c 0) (/= d 5) (/= d 13))
			(emitm-byte (+ o dl))
			(if (or (= d 4) (= d 12)) (emitm-byte 0x24)))
		((<= -0x80 c 0x7f)
			(emitm-byte (+ 0x40 o dl))
			(if (or (= d 4) (= d 12)) (emitm-byte 0x24))
			(emitm-byte c))
		((<= -0x80000000 c 0x7fffffff)
			(emitm-byte (+ 0x80 o dl))
			(if (or (= d 4) (= d 12)) (emitm-byte 0x24))
			(emitm-int c))
		(:t (throw "x64-call-jump-i constant out of range !" c))))

(defun x64-cmp-cr (c r)
	(if (= c 0) (x64-rr 0x85 r r)
		(progn
			(defq rl (logand 7 r) rh (>> r 3))
			(emitm-byte (+ 0x48 rh))
			(cond
				((<= -0x80 c 0x7f)
					(emitm-byte 0x83 (+ 0xf8 rl) c))
				((<= -0x80000000 c 0x7fffffff)
					(if (= r 0)
						(emitm-byte 0x3d)
						(emitm-byte 0x81 (+ 0xf8 rl)))
					(emitm-int c))
				(:t (throw "x64-cmp-cr constant out of range !" c))))))

(defun x64-branch (o l d)
	(defq m (elem-get *offsets* d) l (- l *pc*))
	(and (> *pass* 0) (> (abs l) (abs m)) (elem-set *offsets* d (setq m l)))
	(cond
		((<= -0x80 (- m 2) 0x7f)
			(emitm-byte o (- l 2)))
		((<= -0x80000000 (- m 6) 0x7fffffff)
			(emitm-byte 0xf (+ 0x10 o))
			(emitm-int (- l 6)))
		(:t (throw "x64-branch constant out of range !" l))))

(defun x64-cmp-rr (s d) (x64-rr 0x39 s d))
(defun emit-add-rr (s d) (x64-rr 0x01 s d))
(defun emit-sub-rr (s d) (x64-rr 0x29 s d))
(defun emit-and-rr (s d) (unless (eql s d) (x64-rr 0x21 s d)))
(defun emit-or-rr (s d) (unless (eql s d) (x64-rr 0x09 s d)))
(defun emit-xor-rr (s d) (x64-rr 0x31 s d))

(defun emit-beq-cr (c d l m) (x64-cmp-cr c d) (x64-branch 0x74 l m))
(defun emit-bne-cr (c d l m) (x64-cmp-cr c d) (x64-branch 0x75 l m))
(defun emit-bge-cr (c d l m) (x64-cmp-cr c d) (x64-branch 0x7d l m))
(defun emit-blt-cr (c d l m) (x64-cmp-cr c d) (x64-branch 0x7c l m))
(defun emit-ble-cr (c d l m) (x64-cmp-cr c d) (x64-branch 0x7e l m))
(defun emit-bgt-cr (c d l m) (x64-cmp-cr c d) (x64-branch 0x7f l m))

(defun emit-beq-rr (s d l m) (x64-cmp-rr s d) (x64-branch 0x74 l m))
(defun emit-bne-rr (s d l m) (x64-cmp-rr s d) (x64-branch 0x75 l m))
(defun emit-bge-rr (s d l m) (x64-cmp-rr s d) (x64-branch 0x7d l m))
(defun emit-blt-rr (s d l m) (x64-cmp-rr s d) (x64-branch 0x7c l m))
(defun emit-ble-rr (s d l m) (x64-cmp-rr s d) (x64-branch 0x7e l m))
(defun emit-bgt-rr (s d l m) (x64-cmp-rr s d) (x64-branch 0x7f l m))

(defun emit-or-cr (c r)
	(unless (= c 0)
		(defq rl (logand 7 r) rh (>> r 3))
		(emitm-byte (+ 0x48 rh))
		(cond
			((<= -0x80 c 0x7f)
				(emitm-byte 0x83 (+ 0xc8 rl) c))
			((<= -0x80000000 c 0x7fffffff)
				(if (= r 0)
					(emitm-byte 0x0d)
					(emitm-byte 0x81 (+ 0xc8 rl)))
				(emitm-int c))
			(:t (throw "emit-or-cr constant out of range !" c)))))

(defun emit-seq-cr (c d)
	(x64-cmp-cr c d) (emitm-byte 0x74 5) (emit-xor-rr d d) (emitm-byte 0xeb 4) (emit-or-cr -1 d))
(defun emit-sne-cr (c d)
	(x64-cmp-cr c d) (emitm-byte 0x75 5) (emit-xor-rr d d) (emitm-byte 0xeb 4) (emit-or-cr -1 d))
(defun emit-slt-cr (c d)
	(x64-cmp-cr c d) (emitm-byte 0x7c 5) (emit-xor-rr d d) (emitm-byte 0xeb 4) (emit-or-cr -1 d))
(defun emit-sle-cr (c d)
	(x64-cmp-cr c d) (emitm-byte 0x7e 5) (emit-xor-rr d d) (emitm-byte 0xeb 4) (emit-or-cr -1 d))
(defun emit-sgt-cr (c d)
	(x64-cmp-cr c d) (emitm-byte 0x7f 5) (emit-xor-rr d d) (emitm-byte 0xeb 4) (emit-or-cr -1 d))
(defun emit-sge-cr (c d)
	(x64-cmp-cr c d) (emitm-byte 0x7d 5) (emit-xor-rr d d) (emitm-byte 0xeb 4) (emit-or-cr -1 d))

(defun emit-seq-rr (s d)
	(x64-cmp-rr s d) (emitm-byte 0x74 5) (emit-xor-rr d d) (emitm-byte 0xeb 4) (emit-or-cr -1 d))
(defun emit-sne-rr (s d)
	(x64-cmp-rr s d) (emitm-byte 0x75 5) (emit-xor-rr d d) (emitm-byte 0xeb 4) (emit-or-cr -1 d))
(defun emit-slt-rr (s d)
	(x64-cmp-rr s d) (emitm-byte 0x7c 5) (emit-xor-rr d d) (emitm-byte 0xeb 4) (emit-or-cr -1 d))
(defun emit-sle-rr (s d)
	(x64-cmp-rr s d) (emitm-byte 0x7e 5) (emit-xor-rr d d) (emitm-byte 0xeb 4) (emit-or-cr -1 d))
(defun emit-sgt-rr (s d)
	(x64-cmp-rr s d) (emitm-byte 0x7f 5) (emit-xor-rr d d) (emitm-byte 0xeb 4) (emit-or-cr -1 d))
(defun emit-sge-rr (s d)
	(x64-cmp-rr s d) (emitm-byte 0x7d 5) (emit-xor-rr d d) (emitm-byte 0xeb 4) (emit-or-cr -1 d))

(defun emit-call (l)
	(cond
		((<= -0x80000000 (defq c (- l *pc* 5)) 0x7fffffff)
			(emitm-byte 0xe8)
			(emitm-int c))
		(:t (throw "emit-call constant out of range !" c))))

(defun emit-call-r (r) (x64-call-jump-r 0xd0 r))
(defun emit-call-i (d c) (x64-call-jump-i 0x10 d c))
(defun emit-call-p (l) (x64-call-jump-p 0x15 l))

(defun emit-jmp (l d)
	(defq m (elem-get *offsets* d) c (- l *pc*))
	(and (> *pass* 0) (> (abs c) (abs m)) (elem-set *offsets* d (setq m c)))
	(cond
		((<= -0x80 (- m 2) 0x7f)
			(emitm-byte (+ 0x2 0xe9) (- c 2)))
		((<= -0x80000000 (- m 5) 0x7fffffff)
			(emitm-byte 0xe9)
			(emitm-int (- c 5)))
		(:t (throw "emit-jmp constant out of range !" c))))

(defun emit-jmp-r (r) (x64-call-jump-r 0xe0 r))
(defun emit-jmp-i (d c) (x64-call-jump-i 0x20 d c))
(defun emit-jmp-p (l) (x64-call-jump-p 0x25 l))

(defun emit-lea-i (s c d) (unless (and (= c 0) (eql s d)) (x64-ir 0x8d s c d)))
(defun emit-lea-d (s1 s2 d) (x64-dr 0x8d s1 s2 d))
(defun emit-lea-p (l d) (x64-pr 0x8d l d))

(defun emit-cpy-cr (c r)
	(if (= c 0)
		(emit-xor-rr r r)
		(progn
			(defq rl (logand r 7) rh (>> r 3))
			(cond
				((= -1 c)
					(emit-or-cr -1 r))
				((<= 0 c 0xffffffff)
					(if (>= r 8) (emitm-byte 0x41))
					(emitm-byte (+ 0xb8 rl))
					(emitm-int c))
				((<= -0x80000000 c -1)
					(emitm-byte (+ 0x48 rh) 0xc7 (+ 0xc0 rl))
					(emitm-int c))
				(:t (emitm-byte (+ 0x48 rh) (+ 0xb8 rl))
					(emitm-long c))))))

(defun emit-cpy-rr (s d) (unless (eql s d) (x64-rr 0x89 s d)))
(defun emit-cpy-ir (s c d) (x64-ir 0x8b s c d))
(defun emit-cpy-dr (s1 s2 d) (x64-dr 0x8b s1 s2 d))
(defun emit-cpy-pr (l d) (x64-pr 0x8b l d))

(defun emit-cpy-ri (s d c)
	(cond
		((and (= c 0) (/= d 5) (/= d 13))
			(emitm-byte (+ 0x48 (<< (>> s 3) 2) (>> d 3)) 0x89 (+ (<< (logand 7 s) 3) (logand 7 d)))
			(if (or (= d 4) (= d 12)) (emitm-byte 0x24)))
		((<= -0x80 c 0x7f)
			(emitm-byte (+ 0x48 (<< (>> s 3) 2) (>> d 3)) 0x89 (+ 0x40 (<< (logand 7 s) 3) (logand 7 d)))
			(if (or (= d 4) (= d 12)) (emitm-byte 0x24))
			(emitm-byte c))
		((<= -0x80000000 c 0x7fffffff)
			(emitm-byte (+ 0x48 (<< (>> s 3) 2) (>> d 3)) 0x89 (+ 0x80 (<< (logand 7 s) 3) (logand 7 d)))
			(if (or (= d 4) (= d 12)) (emitm-byte 0x24))
			(emitm-int c))
		(:t (throw "emit-cpy-ri constant out of range !" c))))

(defun emit-cpy-rd (d s1 s2)
	(defq s1l (logand 7 s1) s1h (>> s1 3)
		s2l (logand 7 s2) s2h (>> s2 3)
		dl (logand 7 d) dh (>> d 3))
	(emitm-byte (+ 0x48 (<< dh 2) (<< s2h 1) s1h) 0x89)
	(cond
		((and (/= s1 5) (/= s1 13))
			(emitm-byte (+ 0x04 (<< dl 3)) (+ (<< s2l 3) s1l)))
		(:t (emitm-byte (+ 0x44 (<< dl 3)) (+ (<< s2l 3) s1l) 0))))

(defun emit-cpy-ir-b (s c d) (x64-ir-bs 0xbe s c d))
(defun emit-cpy-dr-b (s1 s2 d) (x64-dr-bs 0xbe s1 s2 d))
(defun emit-cpy-ir-ub (s c d) (x64-ir-bs 0xb6 s c d))
(defun emit-cpy-dr-ub (s1 s2 d) (x64-dr-bs 0xb6 s1 s2 d))
(defun emit-cpy-ir-s (s c d) (x64-ir-bs 0xbf s c d))
(defun emit-cpy-dr-s (s1 s2 d) (x64-dr-bs 0xbf s1 s2 d))
(defun emit-cpy-ir-us (s c d) (x64-ir-bs 0xb7 s c d))
(defun emit-cpy-dr-us (s1 s2 d) (x64-dr-bs 0xb7 s1 s2 d))

(defun emit-cpy-ir-i (s c d)
	(emitm-byte (+ 0x48 (<< (>> d 3) 2) (>> s 3)) 0x63)
	(cond
		((and (= c 0) (/= s 5) (/= s 13))
			(emitm-byte (+ (<< (logand 7 d) 3) (logand 7 s)))
			(if (or (= s 4) (= s 12)) (emitm-byte 0x24)))
		((<= -0x80 c 0x7f)
			(emitm-byte (+ 0x40 (<< (logand 7 d) 3) (logand 7 s)))
			(if (or (= s 4) (= s 12)) (emitm-byte 0x24))
			(emitm-byte c))
		((<= -0x80000000 c 0x7fffffff)
			(emitm-byte (+ 0x80 (<< (logand 7 d) 3) (logand 7 s)))
			(if (or (= s 4) (= s 12)) (emitm-byte 0x24))
			(emitm-int c))
		(:t (throw "emit-cpy-ir-i constant out of range !" c))))

(defun emit-cpy-dr-i (s1 s2 d)
	(defq s1l (logand 7 s1) s1h (>> s1 3)
		s2l (logand 7 s2) s2h (>> s2 3)
		dl (logand 7 d) dh (>> d 3))
	(emitm-byte (+ 0x48 (<< dh 2) (<< s2h 1) s1h) 0x63)
	(cond
		((and (/= s1 5) (/= s1 13))
			(emitm-byte (+ 0x04 (<< dl 3)) (+ (<< s2l 3) s1l)))
		(:t (emitm-byte (+ 0x44 (<< dl 3)) (+ (<< s2l 3) s1l) 0))))

(defun emit-cpy-ir-ui (s c d)
	(if (or (>= s 8) (>= d 8)) (emitm-byte (+ 0x40 (<< (>> d 3) 2) (>> s 3))))
	(emitm-byte 0x8b)
	(cond
		((and (= c 0) (/= s 5) (/= s 13))
			(emitm-byte (+ (<< (logand 7 d) 3) (logand 7 s)))
			(if (or (= s 4) (= s 12)) (emitm-byte 0x24)))
		((<= -0x80 c 0x7f)
			(emitm-byte (+ 0x40 (<< (logand 7 d) 3) (logand 7 s)))
			(if (or (= s 4) (= s 12)) (emitm-byte 0x24))
			(emitm-byte c))
		((<= -0x80000000 c 0x7fffffff)
			(emitm-byte (+ 0x80 (<< (logand 7 d) 3) (logand 7 s)))
			(if (or (= s 4) (= s 12)) (emitm-byte 0x24))
			(emitm-int c))
		(:t (throw "emit-cpy-ir-ui constant out of range !" c))))

(defun emit-cpy-dr-ui (s1 s2 d)
	(defq s1l (logand 7 s1) s1h (>> s1 3)
		s2l (logand 7 s2) s2h (>> s2 3)
		dl (logand 7 d) dh (>> d 3))
	(if (or (>= s1 8) (>= s2 8) (>= d 8)) (emitm-byte (+ 0x40 (<< dh 2) (<< s2h 1) s1h)))
	(emitm-byte 0x8b)
	(cond
		((and (/= s1 5) (/= s1 13))
			(emitm-byte (+ 0x04 (<< dl 3)) (+ (<< s2l 3) s1l)))
		(:t (emitm-byte (+ 0x44 (<< dl 3)) (+ (<< s2l 3) s1l) 0))))

(defun emit-cpy-ri-b (s d c)
	(defq sl (logand 7 s) sh (>> s 3)
		dl (logand 7 d) dh (>> d 3))
	(if (or (>= s 4) (>= d 8)) (emitm-byte (+ 0x40 (<< sh 2) dh)))
	(emitm-byte 0x88)
	(cond
		((and (= c 0) (/= d 5) (/= d 13))
			(emitm-byte (+ (<< sl 3) dl))
			(if (or (= d 4) (= d 12)) (emitm-byte 0x24)))
		((<= -0x80 c 0x7f)
			(emitm-byte (+ 0x40 (<< sl 3) dl))
			(if (or (= d 4) (= d 12)) (emitm-byte 0x24))
			(emitm-byte c))
		((<= -0x80000000 c 0x7fffffff)
			(emitm-byte (+ 0x80 (<< sl 3) dl))
			(if (or (= d 4) (= d 12)) (emitm-byte 0x24))
			(emitm-int c))
		(:t (throw "emit-cpy-ri-b constant out of range !" c))))

(defun emit-cpy-rd-b (r s1 s2)
	(defq s1l (logand 7 s1) s1h (>> s1 3)
		s2l (logand 7 s2) s2h (>> s2 3)
		rl (logand 7 r) rh (>> r 3))
	(if (or (>= s1 8) (>= s2 8) (>= r 4)) (emitm-byte (+ 0x40 (<< rh 2) (<< s2h 1) s1h)))
	(emitm-byte 0x88)
	(cond
		((and (/= s1 5) (/= s1 13))
			(emitm-byte (+ 0x04 (<< rl 3)) (+ (<< s2l 3) s1l)))
		(:t (emitm-byte (+ 0x44 (<< rl 3)) (+ (<< s2l 3) s1l) 0))))

(defun emit-cpy-ri-s (s d c)
	(defq sl (logand 7 s) sh (>> s 3)
		dl (logand 7 d) dh (>> d 3))
	(emitm-byte 0x66)
	(if (or (>= s 8) (>= d 8)) (emitm-byte (+ 0x40 (<< sh 2) dh)))
	(emitm-byte 0x89)
	(cond
		((and (= c 0) (/= d 5) (/= d 13))
			(emitm-byte (+ (<< sl 3) dl))
			(if (or (= d 4) (= d 12)) (emitm-byte 0x24)))
		((<= -0x80 c 0x7f)
			(emitm-byte (+ 0x40 (<< sl 3) dl))
			(if (or (= d 4) (= d 12)) (emitm-byte 0x24))
			(emitm-byte c))
		((<= -0x80000000 c 0x7fffffff)
			(emitm-byte (+ 0x80 (<< sl 3) dl))
			(if (or (= d 4) (= d 12)) (emitm-byte 0x24))
			(emitm-int c))
		(:t (throw "emit-cpy-ri-s constant out of range !" c))))

(defun emit-cpy-rd-s (r s1 s2)
	(defq s1l (logand 7 s1) s1h (>> s1 3)
		s2l (logand 7 s2) s2h (>> s2 3)
		rl (logand 7 r) rh (>> r 3))
	(emitm-byte 0x66)
	(if (or (>= s1 8) (>= s2 8) (>= r 8)) (emitm-byte (+ 0x40 (<< rh 2) (<< s2h 1) s1h)))
	(emitm-byte 0x89)
	(cond
		((and (/= s1 5) (/= s1 13))
			(emitm-byte (+ 0x04 (<< rl 3)) (+ (<< s2l 3) s1l)))
		(:t (emitm-byte (+ 0x44 (<< rl 3)) (+ (<< s2l 3) s1l) 0))))

(defun emit-cpy-ri-i (s d c)
	(if (or (>= s 8) (>= d 8)) (emitm-byte (+ 0x40 (<< (>> s 3) 2) (>> d 3))))
	(emitm-byte 0x89)
	(cond
		((and (= c 0) (/= d 5) (/= d 13))
			(emitm-byte (+ (<< (logand 7 s) 3) (logand 7 d)))
			(if (or (= d 4) (= d 12)) (emitm-byte 0x24)))
		((<= -0x80 c 0x7f)
			(emitm-byte (+ 0x40 (<< (logand 7 s) 3) (logand 7 d)))
			(if (or (= d 4) (= d 12)) (emitm-byte 0x24))
			(emitm-byte c))
		((<= -0x80000000 c 0x7fffffff)
			(emitm-byte (+ 0x80 (<< (logand 7 s) 3) (logand 7 d)))
			(if (or (= d 4) (= d 12)) (emitm-byte 0x24))
			(emitm-int c))
		(:t (throw "emit-cpy-ri-i constant out of range !" c))))

(defun emit-cpy-rd-i (r s1 s2)
	(defq s1l (logand 7 s1) s1h (>> s1 3)
		s2l (logand 7 s2) s2h (>> s2 3)
		rl (logand 7 r) rh (>> r 3))
	(if (or (>= s1 8) (>= s2 8) (>= r 8)) (emitm-byte (+ 0x40 (<< rh 2) (<< s2h 1) s1h)))
	(emitm-byte 0x89)
	(cond
		((and (/= s1 5) (/= s1 13))
			(emitm-byte (+ 0x04 (<< rl 3)) (+ (<< s2l 3) s1l)))
		(:t (emitm-byte (+ 0x44 (<< rl 3)) (+ (<< s2l 3) s1l) 0))))

(defun emit-add-cr (c r)
	(unless (= c 0)
		(defq rl (logand 7 r) rh (>> r 3))
		(emitm-byte (+ 0x48 rh))
		(cond
			((= 1 c)
				(emitm-byte 0xff (+ 0xc0 rl)))
			((<= -0x80 c 0x7f)
				(emitm-byte 0x83 (+ 0xc0 rl) c))
			((<= -0x80000000 c 0x7fffffff)
				(if (= r 0)
					(emitm-byte 0x05)
					(emitm-byte 0x81 (+ 0xc0 rl)))
				(emitm-int c))
			(:t (throw "emit-add-cr constant out of range !" c)))))

(defun emit-sub-cr (c r)
	(unless (= c 0)
		(defq rl (logand 7 r) rh (>> r 3))
		(emitm-byte (+ 0x48 rh))
		(cond
			((= 1 c)
				(emitm-byte 0xff (+ 0xc8 rl)))
			((<= -0x80 c 0x7f)
				(emitm-byte 0x83 (+ 0xe8 rl) c))
			((<= -0x80000000 c 0x7fffffff)
				(if (= r 0)
					(emitm-byte 0x2d)
					(emitm-byte 0x81 (+ 0xe8 rl)))
				(emitm-int c))
			(:t (throw "emit-sub-cr constant out of range !" c)))))

(defun emit-and-cr (c r)
	(unless (= c -1)
		(if (= c 0)
			(emit-xor-rr r r)
			(progn
				(defq rl (logand 7 r) rh (>> r 3))
				(emitm-byte (+ 0x48 rh))
				(cond
					((<= -0x80 c 0x7f)
						(emitm-byte 0x83 (+ 0xe0 rl) c))
					((<= -0x80000000 c 0x7fffffff)
						(if (= r 0)
							(emitm-byte 0x25)
							(emitm-byte 0x81 (+ 0xe0 rl)))
						(emitm-int c))
					(:t (throw "emit-and-cr constant out of range !" c)))))))

(defun emit-xor-cr (c r)
	(unless (= c 0)
		(defq rl (logand 7 r) rh (>> r 3))
		(emitm-byte (+ 0x48 rh))
		(cond
			((<= -0x80 c 0x7f)
				(emitm-byte 0x83 (+ 0xf0 rl) c))
			((<= -0x80000000 c 0x7fffffff)
				(if (= r 0)
					(emitm-byte 0x35)
					(emitm-byte 0x81 (+ 0xf0 rl)))
				(emitm-int c))
			(:t (throw "emit-xor-cr constant out of range !" c)))))

(defun emit-lnot-rr (r d)
	(if (>= d 4)
		(throw "emit-lnot-rr illegal register !" d))
	(emit-cpy-rr d r)
	(emit-xor-rr d d)
	(x64-cmp-cr 0 r)
	(emitm-byte 0x0f 0x94 (+ 0xc0 d)))

(defun emit-land-rr (s d)
	(if (or (>= s 4) (>= d 4))
		(throw "emit-land-rr illegal register !" (list s d)))
	(x64-cmp-cr 0 d)
	(emitm-byte 0x0f 0x95 (+ 0xc0 d))
	(x64-cmp-cr 0 s)
	(emitm-byte 0x0f 0x95 (+ 0xc0 s))
	(emit-and-rr s d))

(defun emit-mul-rr (s d)
	(defq sl (logand 7 s) sh (>> s 3)
		dl (logand 7 d) dh (>> d 3))
	(emitm-byte (+ 0x48 (<< dh 2) sh) 0x0f 0xaf (+ 0xc0 (<< dl 3) sl)))

(defun emit-div-rrr (s d1 d2)
	(cond
		((and (eql d1 2) (eql d2 0))
			(defq sl (logand 7 s) sh (>> s 3))
			(emitm-byte (+ 0x48 sh) 0xF7 (+ 0xF8 sl)))
		((and (eql d1 0) (eql d2 2) (nql s 0) (nql s 2))
			(defq sl (logand 7 s) sh (>> s 3))
			(emitm-byte 0x48 0x92 (+ 0x48 sh) 0xF7 (+ 0xF8 sl) 0x48 0x92))
		(:t (emit-push d2 d1 s (const (emit-native-reg? :r2)) (const (emit-native-reg? :r1)) (const (emit-native-reg? :r0)))
			(emit-cpy-ir (const (emit-native-reg? :rsp)) 24 (const (emit-native-reg? :r1)))
			(emit-cpy-ir (const (emit-native-reg? :rsp)) 32 (const (emit-native-reg? :r2)))
			(emit-cpy-ir (const (emit-native-reg? :rsp)) 40 (const (emit-native-reg? :r0)))
			(emitm-byte 0x48 0xF7 0xF9)
			(emit-cpy-ri (const (emit-native-reg? :r2)) (const (emit-native-reg? :rsp)) 32)
			(emit-cpy-ri (const (emit-native-reg? :r0)) (const (emit-native-reg? :rsp)) 40)
			(emit-pop d2 d1 s (const (emit-native-reg? :r2)) (const (emit-native-reg? :r1)) (const (emit-native-reg? :r0))))))

(defun emit-div-rrr-u (s d1 d2)
	(cond
		((and (eql d1 2) (eql d2 0))
			(defq sl (logand 7 s) sh (>> s 3))
			(emitm-byte (+ 0x48 sh) 0xF7 (+ 0xF0 sl)))
		((and (eql d1 0) (eql d2 2) (nql s 0) (nql s 2))
			(defq sl (logand 7 s) sh (>> s 3))
			(emitm-byte 0x48 0x92 (+ 0x48 sh) 0xF7 (+ 0xF0 sl) 0x48 0x92))
		(:t (emit-push d2 d1 s (const (emit-native-reg? :r2)) (const (emit-native-reg? :r1)) (const (emit-native-reg? :r0)))
			(emit-cpy-ir (const (emit-native-reg? :rsp)) 24 (const (emit-native-reg? :r1)))
			(emit-cpy-ir (const (emit-native-reg? :rsp)) 32 (const (emit-native-reg? :r2)))
			(emit-cpy-ir (const (emit-native-reg? :rsp)) 40 (const (emit-native-reg? :r0)))
			(emitm-byte 0x48 0xF7 0xF1)
			(emit-cpy-ri (const (emit-native-reg? :r2)) (const (emit-native-reg? :rsp)) 32)
			(emit-cpy-ri (const (emit-native-reg? :r0)) (const (emit-native-reg? :rsp)) 40)
			(emit-pop d2 d1 s (const (emit-native-reg? :r2)) (const (emit-native-reg? :r1)) (const (emit-native-reg? :r0))))))

(defun emit-alloc (c) (emit-sub-cr (align c stack_align) (const (emit-native-reg? :rsp))))
(defun emit-free (c) (emit-add-cr (align c stack_align) (const (emit-native-reg? :rsp))))
(defun emit-ret () (emitm-byte 0xc3))
(defun emit-sync (n) (emitm-byte 0x0f 0xae 0xf0))
(defun emit-brk (n))

(defun emit-stack-init (s f x)
	(defq tk_state_size (* +ptr_size (length stack_state)))
	(emit-sub-cr (+ tk_state_size (* +ptr_size 2)) s)
	(emit-cpy-ri f s tk_state_size)
	(emit-cpy-ri x s (+ tk_state_size +ptr_size)))

(defun emit-shift-cr (o c d)
	(unless (= c 0)
		(defq dl (logand 7 d) dh (>> d 3))
		(emitm-byte (+ 0x48 dh))
		(cond
			((= c 1)
				(emitm-byte 0xd1 (+ o dl)))
			((<= c 0xff)
				(emitm-byte 0xc1 (+ o dl) c))
			(:t (throw "emit-shift-cr constant out of range !" c)))))

(defun emit-shift-rr (o s d)
	(cond
		((eql s 1)
			(defq dl (logand 7 d) dh (>> d 3))
			(emitm-byte (+ 0x48 dh) 0xd3 (+ o dl)))
		((eql d 1)
			(defq sl (logand 7 s) sh (>> s 3))
			(emit-swp-rr s d)
			(emitm-byte (+ 0x48 sh) 0xd3 (+ o sl))
			(emit-swp-rr s d))
		(:t (emit-push d s (const (emit-native-reg? :r0)) (const (emit-native-reg? :r1)))
			(emit-cpy-ir (const (emit-native-reg? :rsp)) 24 (const (emit-native-reg? :r0)))
			(emit-cpy-ir (const (emit-native-reg? :rsp)) 16 (const (emit-native-reg? :r1)))
			(emitm-byte 0x48 0xd3 o)
			(emit-cpy-ri (const (emit-native-reg? :r0)) (const (emit-native-reg? :rsp)) 24)
			(emit-pop d s (const (emit-native-reg? :r0)) (const (emit-native-reg? :r1))))))

(defun emit-shl-cr (c r) (emit-shift-cr 0xe0 c r))
(defun emit-shl-rr (s d) (emit-shift-rr 0xe0 s d))
(defun emit-shr-cr (c r) (emit-shift-cr 0xe8 c r))
(defun emit-shr-rr (s d) (emit-shift-rr 0xe8 s d))
(defun emit-asr-cr (c r) (emit-shift-cr 0xf8 c r))
(defun emit-asr-rr (s d) (emit-shift-rr 0xf8 s d))

(defun emit-ext-rr (s d)
	(cond
		((and (eql s 0) (eql d 2))
			(emitm-byte 0x48 0x99))
		((eql s d)
			(emit-asr-cr 63 d))
		(:t (emit-cpy-rr s d)
			(emit-asr-cr 63 d))))

(defun emit-mul-cr (c r)
	(cond
		((= c 1))
		((= c 0)
			(emit-xor-rr r r))
		((defq s (log2 c))
			(emit-shl-cr s r))
		(:t (defq rl (logand r 7) rh (>> r 3))
			(cond
				((= -1 c)
					(emitm-byte (+ 0x48 rh) 0xf7 (+ 0xd8 rl)))
				((<= -0x80 c 0x7f)
					(emitm-byte (+ 0x48 (<< rh 2) rh) 0x6b (+ 0xc0 rl (<< rl 3)) c))
				((<= -0x80000000 c 0x7fffffff)
					(emitm-byte (+ 0x48 (<< rh 2) rh) 0x69 (+ 0xc0 rl (<< rl 3)))
					(emitm-int c))
				(:t (throw "emit-mul-cr constant out of range !" c))))))

(defun x64-cmov-rr (c s d)
	(defq sl (logand 7 s) sh (>> s 3) dl (logand 7 d) dh (>> d 3))
	(emitm-byte (+ 0x48 (<< dh 2) sh) 0x0f c (+ 0xc0 (<< dl 3) sl)))

(defun emit-min-cr (c d l m)
	(emit-ble-cr c d l m)
	(emit-cpy-cr c d))

(defun emit-max-cr (c d l m)
	(emit-bge-cr c d l m)
	(emit-cpy-cr c d))

(defun emit-min-rr (s d l m)
	(unless (eql s d)
		(x64-cmp-rr s d)
		(x64-cmov-rr 0x4f s d)))

(defun emit-max-rr (s d l m)
	(unless (eql s d)
		(x64-cmp-rr s d)
		(x64-cmov-rr 0x4c s d)))

(defun emit-abs-rr (s d l m)
	(unless (eql s d) (emit-cpy-rr s d))
	(emit-bge-cr 0 d l m)
	(emit-mul-cr -1 d))

(case *abi*
(AMD64
(defun emit-call-abi (r b c n &rest x)
	(cond
		((= *func_align* 16)
			(apply (const emit-push) x)
			(x64-call-jump-i 0x10 b c)
			(emit-add-cr (* +ptr_size (length x)) (const (emit-native-reg? :rsp))))
		(:t (setq x (cat (list r r) x))
			(emit-cpy-rr (const (emit-native-reg? :rsp)) r)
			(emit-and-cr -16 (const (emit-native-reg? :rsp)))
			(apply (const emit-push) x)
			(x64-call-jump-i 0x10 b c)
			(emit-cpy-ir (const (emit-native-reg? :rsp)) (* +ptr_size (- (length x) 2)) (const (emit-native-reg? :rsp)))))))
(WIN64
(defun emit-call-abi (r b c n &rest x)
	(cond
		((= *func_align* 16)
			(if (odd? (length x))
				(setq x (cat (list r) x)))
			(apply (const emit-push) x)
			(emit-sub-cr 32 (const (emit-native-reg? :rsp)))
			(x64-call-jump-i 0x10 b c)
			(emit-add-cr (* +ptr_size (+ (length x) 4)) (const (emit-native-reg? :rsp))))
		(:t (emit-cpy-rr (const (emit-native-reg? :rsp)) r)
			(emit-and-cr -16 (const (emit-native-reg? :rsp)))
			(if (odd? (length x))
				(defq y (cat (list r) x))
				(defq y (cat (list r r) x)))
			(apply (const emit-push) y)
			(emit-sub-cr 32 (const (emit-native-reg? :rsp)))
			(x64-call-jump-i 0x10 b c)
			(emit-cpy-ir (const (emit-native-reg? :rsp)) (* +ptr_size (+ (length x) 4)) (const (emit-native-reg? :rsp)))))))
(:t (throw (cat "Unknown ABI for CPU " *cpu* " !") *abi*)))

;module, that exports everything !
(export-symbols (map (const first) (tolist (env))))
(env-pop)
